perm filename CB.F4[SAT,LCS] blob sn#496779 filedate 1981-07-22 generic text, type T, neo UTF8
	SUBROUTINE CMBN
	COMMON /RC/MCLEF(1)
	COMMON /FL/NX,N,L,M,NM,J,NT
	COMMON /SAV/JCLEF(10),KCLEF(10),NMLST(10)
	DIMENSION IP(10),NMS(10),NF(500)
C  USE FILE NAMES CLFX, DRAW1 AND DRAW2.  400 WD LIMIT PER FILE.
CC	IF(N.EQ.'S')GO TO 103
102	TYPE 1
1	FORMAT(' TYPE OUTPUT FILE NAME ',$)
	DO 122 K=1,10
	IP(K)=0
122	NMS(K)=' '
	CALL A5IN(NM)
	IF(NM.EQ.'B'.OR.NM.EQ.'99')RETURN
	IF(NM.NE.' ')GO TO 40
	NM=LASTNM
	TYPE 107,LASTNM
40	LASTNM=NM
	IF(LOOKF(NM).EQ.0)GO TO 100
	IF(N.NE.'C')GO TO 103
C  FOR ADDING TO COMBINED FILE.
	TYPE 101,NM
	CALL A5IN(NX)
	IF(NX.EQ.'N')GO TO 102
100	IF(N.EQ.'C')GO TO 104
CCCC	TYPE 52
	TYPE 109
	CALL A5IN(NMLST)
	IF(NMLST(1).EQ.' ')GO TO 102
	JCLEF(1)=1
	DO 1111 K=2,10
	JCLEF(K)=0
1111	NMLST(K)=' '
	CALL RDSAV(JCLEF,NMLST,MCLEF,NM,MCLEF,0)
	RETURN   
104	L=0
	NX=1
	I=0
30	L=L+1
	TYPE 41
41	FORMAT(' TYPE FILE NAME ',$)
	CALL A5IN(NW)
	IF(NW.EQ.' ')GO TO 8
	IF(LOOKF(NW))GO TO 51
	TYPE 52
	GO TO 30
52	FORMAT(' FILE NOT FOUND'/)
51	I=I+1
	IP(L)=NX
	NMS(I)=NW
	CALL RDSAV(KCLEF,NMLST,K,NW,MCLEF(NX),-2)
	NX=NX+K
	IF(L.LT.10)GO TO 30
101	FORMAT(' WRITE OVER ',A5,'.DMD?  Y OR N?  ',$)
8	NX=NX-1
14	CALL RDSAV(IP,NMS,NX,NM,MCLEF,0)
	L=NX
	RETURN

1103	TYPE 1104,ID
1104	FORMAT(' FILE FULL -- SAVED AS ',A5)
	L=1
	NM=ID
	NX=MCLEF(1)
	GO TO 8

103	CALL RDSAV(IP,NMS,NX,NM,NF,-1)
107	FORMAT(1X,A5)
	TYPE 109
109	FORMAT(' TYPE ID NAME (<CR>=BACKUP) -- ',$)
	CALL A5IN(ID)
	IF(ID.EQ.' ')GO TO 102
	JD=0
	L=0
CC	NX=NX-1
	DO 110 K=1,10
	IF(NMS(K).EQ.ID)JD=K
	IF(NMS(K).EQ.' ')GO TO 112
	L=K
110	IF(JD.EQ.0.AND.K.EQ.10)GO TO 1103
112	IF(N.EQ.'Z')GO TO 127
C  FOR DELETIONS
	L=L+1
	IF(JD.NE.0)GO TO 111
C ADDS ON TO END
	N=0
	IP(L)=NX+1
	DO 113 K=NX+1,MCLEF(1)+NX
	N=N+1
113	NF(K)=MCLEF(N)
	NX=NX+N
	NMS(L)=ID
	L=L+1
114	DO 115 K=1,NX
115	MCLEF(K)=NF(K)
C MOVES IT ALL TO MCLEF
	GO TO 14

127	MCLEF(1)=0
111	N=IP(JD)
	NR=MCLEF(1)
	M=NF(IP(JD))
	NW=NR-M
	NX=NX+NW
	IF(NW)201,120,203
201	JA=N+NR
	JB=NX
	JC=1
	GO TO 204
203	JA=NX
	JB=N+NW
	JC=-1
204	DO 121 K=JA,JB,JC
121	NF(K)=NF(K-NW)
	IF(NR.EQ.0)GO TO 126
120	DO 117 K=1,NR
	NF(N)=MCLEF(K)
117	N=N+1 
CC	L=L-1
	IF(NW.EQ.0)GO TO 114
	DO 119 K=JD+1,L
119	IP(K)=IP(K)+NW
C  FIXES UP FIRST LINE.
CC123	L=L-1
CC	NX=NX-1
	GO TO 114
126	IP(L+1)=0
CC	L=L-1
	DO 124 K=JD,L-1
	IP(K)=IP(K+1)+NW
124	NMS(K)=NMS(K+1)
	NMS(L)=' '
	GO TO 114
	END

CC	SUBROUTINE A5IN(N)
CC10	FORMAT(A5)
CC	ACCEPT 10,N
CC	CALL LO2UP(N)
CC	END

	SUBROUTINE RDSAV(KT,NMS,K,NAME,IO,L)
C  POINTER LIST, NAME LIST, WDCNT, FILE NAME, DATA, RD OR WRT.
	COMMON /RC/MCLEF(1)  /FL/IC,NH,NQ,A,B,C,D
	DIMENSION KT(1),NMS(1),IO(1),JALL(21)
	IF(L)GO TO 5
C  L=-1  FOR READER, -2=NO TYPE OF NAME LIST.
	DO 1 N=1,10
	JALL(N)=KT(N)
1	JALL(N+11)=NMS(N)
	JALL(11)=K
	TYPE 6,K
C THESE ROUTINES ARE IN 'MSSIO.FAI'
	CALL PUTEXT(NAME,'DMD')
	CALL EXTOUT(JALL,21)
	CALL EXTOUT(IO,K+1)
	CALL FINEXT
	RETURN

5	CALL GETEXT(NAME,'DMD')
	CALL EXTIN(JALL,21)
	K=JALL(11)
	TYPE 6,K
6	FORMAT(' TOTAL WDS=',I3,'/350')
	CALL EXTIN(IO,K)
	DO 2 N=1,10
	KT(N)=JALL(N)
2	NMS(N)=JALL(N+11)
	IF(L.EQ.-2)RETURN
	TYPE 3
	TYPE 4,(NMS(N),N=1,10)
3	FORMAT(
	1'  0      1      2      3      4      5      6      7
	1      8      9')
4	FORMAT(' IDENT. NAMES:'/,10(2XA5))
	END